home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
C64
/
A-Monthly Disks
/
(c)aap.d64
/
bodycalc
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2007-02-04
|
9KB
|
357 lines
1 REM*****BODYCALC*****
2 BB=53280:SS=53281
3 POKEBB,0:POKESS,12:PRINT"[144]"
5 DIMA$(600,6),B$(600,6),Y$(50,6)
6 PRINTCHR$(147)
10 PRINTCHR$(147);TAB(9):FORR=1TO20:PRINT"[144][209]";:FORL=1TO30:NEXTL:NEXTR
11 FORR=1TO20:PRINTTAB(29)"[209]":FORL=1TO30:NEXTL:NEXTR:Q=30:FORR=1TO21:Q=Q-1
12 PRINT"";TAB(Q)"[209]":FORL=1TO30:NEXTL:NEXTR:FORR=1TO19
13 PRINTTAB(9);CHR$(145)+CHR$(145);"[209]":FORL=1TO30:NEXTL:NEXTR:PRINT""
14 PRINTTAB(10):FORR=1TO19:PRINT"[209]";:FORL=1TO30:NEXTL:NEXTR
15 PRINT"";TAB(10):FORR=1TO19:PRINT"[209]";:FORL=1TO30:NEXTL:NEXTR
16 PRINT"";TAB(15)"BODYCALC"
17 PRINTTAB(11)"[144]BY GREGG O. BYERS"
19 FORA=1TO3000:NEXT:PRINT"[147][144]"
29 GOTO3000
30 REM FOOD GROUP SEARCH
31 PRINTCHR$(147):PRINTTAB(7)"FOOD GROUP SEARCH[146]"
32 INPUT"ENTER FOOD/END";C$
33 IFC$="END"THEN3000
34 RESTORE:PRINTCHR$(147):R=0:G=0
35 PRINT"TYPE/PORTION";TAB(26)"CAL";TAB(30)"P";TAB(33)"F";TAB(35)"CARB[146]":PRINT
36 FORB=1TOX
37 IFA$(B,1)=C$THEN39
38 GOTO46
39 PRINTA$(B,2);TAB(26)A$(B,3);TAB(30)A$(B,4);TAB(33)A$(B,5);TAB(36)A$(B,6)
40 R=R+1:G=G+1
41 IFR<=16THEN46
42 IFR=17THENPRINT"PRESS <RETURN> TO CONTINUE LIST"
43 GETY$:IFY$=""THEN44
44 IFY$=CHR$(13)THENPRINTCHR$(147):R=0:PRINT"TYPE/PORTION","CAL","P","F","CARB[146]"
45 PRINTTAB(25)"P";TAB(28)"F";TAB(32)"CARB[146]":GOTO46
46 NEXTB
47 IFG=0THENPRINT"THAT FOOD NOT FOUND AS TYPED. TRY AGAIN":GOTO32
48 GOTO32
49 REM LISTING OF CALORIE INDEX
50 PRINTCHR$(147)
55 R=0
57 FORB=1TOX
60 R=R+1
65 PRINTA$(B,1),A$(B,2);TAB(35)B
67 IFR<=16THEN80
70 IFR=17THENPRINT"PRESS <RETURN> TO CONTINUE LIST"
72 PRINT"PRESS <C> TO COUNT CALORIES"
73 PRINT"PRESS <D> FOR DAILY MENU"
75 GETQ$:IFQ$=""THEN75
76 IFQ$=CHR$(13)THENPRINTCHR$(147):R=0:GOTO80
77 IFQ$="D"THEN4000
79 IFQ$="C"THEN97
80 NEXTB
81 PRINT"<L>TO LIST"
82 PRINT"<C>TO COUNT CALORIES"
83 PRINT"<D> FOR DAILY CALORIE MENU"
85 GETW$:IFW$=""THEN85
87 IFW$="L"THEN50
89 IFW$="C"THEN97
92 IFW$="D"THEN4000
93 GOTO85
95 GOTO85
96 REM CALORIE SEARCH
97 PRINTCHR$(147):POKESS,12:PRINTTAB(10)"COUNTING CALORIES[146]"
98 PRINT"ENTER FOOD OR <D>AILY MENU":INPUTC$
99 RESTORE:PRINTCHR$(147):R=0:G=0:IFC$="D"THEN4000
100 FORB=1TOX
103 IFA$(B,1)=C$THENR=R+1:G=G+1:PRINTA$(B,1),A$(B,2);TAB(35)B
104 IFR<=16THEN109
105 IFR=17THENPRINT"PRESS <RETURN> TO CONTINUE LIST"
106 GETY$:IFY$=""THEN106
107 IFY$=CHR$(13)THENPRINTCHR$(147):R=0:GOTO109
108 GOTO106
109 NEXTB
110 IFG=0THENPRINT"THAT FOOD NOT FOUND AS TYPED. TRY AGAIN":GOTO98
111 PRINT"PRESS <0> IF FOOD IS NOT LISTED[146]"
112 INPUT"NUMBER OF CHOICE";J
113 IFJ=0 THEN203
116 PRINTCHR$(147):C=VAL(A$(J,3)):D=D+C
117 PRINT""
118 E=VAL(A$(J,4)):F=F+E:G=VAL(A$(J,5)):H=H+G:I=VAL(A$(J,6)):K=K+I
119 PRINT"FOOD[146] ";A$(J,1):PRINTA$(J,2):PRINT"CALORIES[146] ";C
120 PRINT"PROTEIN[146] ";F
121 PRINT"FATS[146] ";H
122 PRINT"CARBOHYDRATES[146] ";K
130 PRINT"":PRINTTAB(15)"TOTAL CAL.[146]";D
131 U=U+1:Y$(U,1)=A$(J,1):Y$(U,2)=A$(J,2):Y$(U,3)=A$(J,3)
132 Y$(U,4)=A$(J,4):Y$(U,5)=A$(J,5):Y$(U,6)=A$(J,6)
202 PRINT""
203 PRINT"PRESS<C> TO CONTINUE"
204 PRINT"PRESS<D> FOR DAILY MENU"
205 PRINT"PRESS<L> TO LIST"
206 PRINT"PRESS<P> FOR PRINTOUT"
207 PRINT"PRESS<+> TO ENTER SAME ENTRY AGAIN"
210 GETL$:IFL$=""THEN210
215 IFL$="C"THEN97
217 IFL$="+"THENPRINTCHR$(147):GOTO116
220 IFL$="D"THEND=0:F=0:H=0:K=0:U=0:GOTO4000
225 IFL$="L"THEN50
226 IFL$="P"THEN228
227 GOTO210
228 INPUT"TYPE MONTH/DAY/YEAR";V$
229 OPEN1,4:CMD1:
230 PRINT#1,V$;" [168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168]"
231 PRINT#1,"FOOD";
232 PRINT#1,CHR$(16)"20";"AMOUNT";CHR$(16)"40";"CAL";CHR$(16)"45";"P";
233 PRINT#1,CHR$(16)"50";"F";CHR$(16)"55";"CARB"
234 PRINT#1
235 FORZ=1TOU
237 PRINT#1,Y$(Z,1);
238 PRINT#1,CHR$(16)"16"Y$(Z,2);
239 PRINT#1,CHR$(16)"40"Y$(Z,3);
240 PRINT#1,CHR$(16)"45"Y$(Z,4);
242 PRINT#1,CHR$(16)"50"Y$(Z,5);
245 PRINT#1,CHR$(16)"55"Y$(Z,6)
247 NEXTZ
250 PRINT#1
251 PRINT#1,"TOTALS[146][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210][210]"
252 PRINT#1,"CALORIES ";D
253 PRINT#1,"PROTEIN ";F
254 PRINT#1,"FATS ";H
255 PRINT#1,"CARBOHYDRATES ";K
256 PRINT#1,"[168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168][168]"
257 CLOSE1
258 D=0:F=0:H=0:K=0:U=0
259 GOTO4000
998 REM WRITE FILE
999 POKESS,12:PRINTCHR$(147)
1000 PRINT"OPENING FILE TO WRITE"
1001 S=0:OPEN15,8,15:OPEN2,8,2,"@0:FOOD,SEQ,W"
1002 GOSUB10000
1003 S=S+1:PRINTCHR$(147)
1004 INPUT" FOOD NAME";B$(S,1)
1005 IFB$(S,1)<>"END"THEN1008
1006 IFB$(S,1)="END"THENCLOSE2:GOSUB10000
1007 GOTO30000
1008 INPUT"TYPE/PORTION";B$(S,2)
1009 INPUT" CALORIES";B$(S,3)
1010 INPUT" PROTEIN ";B$(S,4)
1011 INPUT" FAT ";B$(S,5)
1012 INPUT" CARBOHYDRATES ";B$(S,6)
1013 INPUT"PRESS <1>TO SAVE<2>TO CHANGE";O
1014 IFO=1THEN1020
1015 IFO=2THENPRINTCHR$(147):GOTO1004
1020 PRINT#2,B$(S,1)
1021 PRINT#2,B$(S,2)
1022 PRINT#2,B$(S,3)
1023 PRINT#2,B$(S,4)
1024 PRINT#2,B$(S,5)
1025 PRINT#2,B$(S,6)
1030 IFST<>0GOTO22000:REM STATUS
1045 PRINTCHR$(147):GOTO1003
1050 CLOSE2
1060 GOSUB10000
1065 GOSUB30000
1070 GOTO3000
1998 REM READ FILE
1999 PRINTCHR$(147):PRINT"LOADING CALORIE INDEX"
2000 OPEN15,8,15:OPEN2,8,2,"0:FOOD,SEQ,R"
2003 GOSUB10000
2004 X=1:A=1
2005 INPUT#2,A$(A,1)
2006 INPUT#2,A$(A,2)
2007 INPUT#2,A$(A,3)
2008 INPUT#2,A$(A,4)
2009 INPUT#2,A$(A,5)
2010 INPUT#2,A$(A,6)
2011 PRINTTAB(10)"[147]LOADING CALORIE INDEX";TAB(20)X
2012 IFST<>0THEN11000
2013 IFST=64THEN2015
2014 X=X+1:A=A+1:GOTO2005
2015 CLOSE2
2016 GOSUB10000
2017 GOSUB30000
2018 PRINT"[144]":GOTO4000
2999 REM MAIN MENU
3000 PRINTCHR$(147):POKESS,12
3001 PRINT" [166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]"
3002 FORA=1TO21
3003 PRINT" [166] [166]"
3004 NEXTA
3005 PRINT" [166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]"
3020 PRINT"":PRINTTAB(15)"MAIN MENU"
3025 PRINTTAB(4)"PRESS <C> TO CREATE NEW DATA FILE"
3030 PRINTTAB(4)"PRESS <D> FOR DAILY CALORIE MENU"
3035 PRINTTAB(4)"PRESS <U> TO UPDATE DATA"
3040 PRINTTAB(4)"PRESS <E> TO EXIT PROGRAM"
3045 GETLL$:IFLL$=""THEN3045
3050 IFLL$="C"THEN999
3055 IFLL$="D"THEN4000
3060 IFLL$="U"THEN5000
3065 IFLL$="E"THENPRINT"[147]":END
3067 END
3999 REM DAILY COUNT MENU **************
4000 PRINTCHR$(147)
4001 PRINT" [166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]"
4002 FORA=1TO21
4003 PRINT" [166] [166]"
4004 NEXTA
4005 PRINT" [166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]"
4020 PRINT"":PRINTTAB(10)"DAILY CALORIE MENU"
4025 PRINT"":PRINTTAB(7)"PRESS <I> TO LOAD CALORIE INDEX"
4026 PRINT"":PRINTTAB(7)"PRESS <C> TO COUNT CALORIES"
4027 PRINTTAB(7)"PRESS[160]<S> FOR FOOD SEARCH"
4028 PRINT"":PRINTTAB(7)"PRESS <L> FOR CALORIE LIST"
4029 PRINT"":PRINTTAB(7)"PRESS <*> FOR NUTRIENT SEARCH"
4030 PRINT"":PRINTTAB(7)"PRESS <M> FOR MAIN MENU"
4035 GETO$:IFO$=""THEN4035
4040 IFO$="I"THEN1999
4041 IFO$="S"THEN30
4042 IFO$="C"THEN97
4043 IFO$="L"THEN50
4044 IFO$="*"THEN7000
4045 IFO$="M"THEN3000
4046 GOTO4035
4999 REM CHANGE**DELETE**ADD********
5000 PRINTCHR$(147)
5001 PRINT" [166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]"
5002 FORA=1TO21
5003 PRINT" [166] [166]"
5004 NEXTA
5005 PRINT" [166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166][166]"
5006 PRINT"":PRINTTAB(10)"UPDATE CALORIE INDEX"
5007 PRINTTAB(7)"ENTER # OF ENTRY TO CHANGE,"
5008 PRINTTAB(7)"ADD, OR DELETE."
5011 PRINTTAB(7)"TOTAL OF ENTRIES = ";X
5014 INPUT"TYPE # HERE-----";J
5015 IFJ=0THEN5127
5030 FORB=1TOX
5050 IFJ=BTHEN5054
5052 NEXTB
5053 IFJ >XTHENGOTO6000
5054 PRINT"":INPUT"PRESS<1>TO DELETE <2> TO CHANGE";W
5055 IFW=1THENX=X+1:GOTO5000
5056 IFW=2THENPRINTCHR$(147):GOTO5057
5057 PRINT"F ";A$(B,1)
5058 PRINT"T ";A$(B,2)
5059 PRINT"C ";A$(B,3)
5060 PRINT"P ";A$(B,4)
5061 PRINT"F ";A$(B,5)
5062 PRINT"C ";A$(B,6)
5080 INPUT"";A$(B,1)
5085 INPUT"";A$(B,2)
5086 INPUT"";A$(B,3)
5087 INPUT"";A$(B,4)
5088 INPUT"";A$(B,5)
5089 INPUT"";A$(B,6)
5090 GOTO5115
5115 INPUT"PRESS<1>TO SAVE <2> TO CHANGE";O
5120 IFO=1THEN5000
5121 IFO=2THEN5080
5127 OPEN15,8,15:OPEN2,8,2,"@0:FOOD,SEQ,W"
5128 GOSUB10000
5129 FORB=1TOX
5130 PRINT#2,A$(B,1)
5131 PRINT#2,A$(B,2)
5132 PRINT#2,A$(B,3)
5133 PRINT#2,A$(B,4)
5134 PRINT#2,A$(B,5)
5135 PRINT#2,A$(B,6)
5136 NEXTB
5137 IFST<>0GOTO11000
5150 CLOSE2
5160 GOSUB10000
5170 CLOSE15
5171 GOTO30000
6000 X=X+1:B=X
6002 PRINTCHR$(147)
6005 INPUT"FOOD";A$(B,1)
6007 INPUT"TYPE/PORTION";A$(B,2)
6010 INPUT"CAL.";A$(B,3)
6015 INPUT"PROTEIN";A$(B,4)
6020 INPUT"FAT";A$(B,5)
6025 INPUT"CARB";A$(B,6)
6060 INPUT"PRESS <1> TO SAVE <2> TO CHANGE";TT
6065 IFTT=1THEN5000
6070 IFTT=2THENPRINTCHR$(147):GOTO6005
6999 REM *NUTRIENT CONTENT COUNT******
7000 PRINTCHR$(147):PRINT"HIGH/LOW NUTRIENT CONTENT[146]":R=0:G=0
7001 PRINT""
7002 PRINTTAB(10)"3=CALORIES"
7003 PRINTTAB(10)"4=PROTEINS"
7004 PRINTTAB(10)"5=FATS"
7005 PRINTTAB(10)"6=CARBOHYDRATES"
7006 INPUT"HIGH IN (NAME)";SS$
7007 INPUT"TYPE # OF NUTRIENT FOR HIGH";CC
7008 INPUT"AND LOW IN (NAME)?";TT$
7009 INPUT"TYPE # OF NUTRIENT FOR LOW";DD
7010 PRINT"[147]MINUMUM AMOUNT FOR ";SS$:INPUTFF$
7011 PRINT"MAXIMUM AMOUNT FOR ";TT$:INPUTGG$
7012 IFSS$="CALORIES"THENMM$="CALORIES"
7013 IFSS$<>"CALORIES"THENMM$="GRAMS"
7014 IFTT$="CALORIES"THENNN$="CALORIES"
7015 IFTT$<>"CALORIES"THENNN$="GRAMS"
7016 PRINTCHR$(147):PRINT"S[146]CREEN/P[146]RINTER"
7017 GETII$:IFII$=""THEN7017
7018 IFII$="S"THEN7022
7019 IFII$="P"THEN7085
7020 GOTO7017
7022 FORB=1TOX
7030 IFVAL(A$(B,CC))>=VAL(FF$)ANDVAL(A$(B,DD))<=VAL(GG$)THEN7032
7031 GOTO7040
7032 R=R+1:G=G+1:PRINTA$(B,1),A$(B,2)
7033 IFR<=16THEN7040
7034 IFR=17THENR=0:GOTO7035
7035 PRINT"PRESS RETURN TO CONTINUE"
7036 GETYY$:IFYY$=""THEN7036
7037 IFYY$=CHR$(13)THENPRINTCHR$(147):GOTO7040
7040 NEXTB
7045 IFG=0THENPRINT"NO FOODS MET THOSE REQUIREMENTS[146]"
7050 PRINT"N[146]UTRITIONAL ANALYSIS/D[146]AILY MENU"
7055 GETWW$:IFWW$=""THEN7055
7056 IFWW$="N"THEN7000
7057 IFWW$="D"THEN4000
7058 GOTO7055
7085 FORB=1TOX
7086 IFVAL(A$(B,CC))>=VAL(FF$)ANDVAL(A$(B,DD))<=VAL(GG$)THENG=G+1:GOTO7089
7087 NEXTB
7088 GOTO7091
7089 Y$(G,1)=A$(B,1):Y$(G,2)=A$(B,2):Y$(G,3)=A$(B,3):Y$(G,4)=A$(B,4)
7090 Y$(G,5)=A$(B,5):Y$(G,6)=A$(B,6):GOTO7087
7091 IFG=0THENPRINT"NO FOODS MET THOSE REQUIREMENTS[146]":GOTO7155
7092 OPEN1,4:CMD1:
7093 PRINT#1,"NUTRITIONAL ANALYSIS------------------------------------"
7094 PRINT#1,"BELOW ARE LISTED FOODS HIGH IN ";SS$;" WITH A MINIMUM ";
7095 PRINT#1,"AMOUNT OF ";FF$;" ";MM$
7096 PRINT#1,"AND LOW IN ";TT$;" ";"WITH A MAXIMUM AMOUNT OF ";GG$;" ";NN$
7097 PRINT#1
7100 PRINT#1,"FOOD";
7105 PRINT#1,CHR$(16)"15";"TYPE/PORTION";
7106 PRINT#1,CHR$(16)"45";"CAL";
7107 PRINT#1,CHR$(16)"50";"P";
7108 PRINT#1,CHR$(16)"55";"F";
7109 PRINT#1,CHR$(16)"60";"CARB"
7110 PRINT#1,"[197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197][197]"
7118 FORI=1TOG
7119 PRINT#1,Y$(I,1);
7120 PRINT#1,CHR$(16)"15"Y$(I,2);
7125 PRINT#1,CHR$(16)"45"Y$(I,3);
7130 PRINT#1,CHR$(16)"50"Y$(I,4);
7135 PRINT#1,CHR$(16)"55"Y$(I,5);
7140 PRINT#1,CHR$(16)"60"Y$(I,6)
7145 NEXTI
7150 CLOSE1
7155 PRINT"N[146]UTRITION ANALYSIS/D[146]AILY MENU"
7160 GETEE$:IFEE$=""THEN7160
7165 IFEE$="N"THEN7000
7170 IFEE$="D"THEN4000
7175 GOTO7160
9990 REM***SUBR CHECK ERROR CHAN*******
10000 INPUT#15,CZ,MZ$,TZ,SZ
10010 IFCZ<20THENRETURN:REM OK
10020 PRINT"DOS ERRO:"
10030 PRINTCZ,MZ$,TZ,SZ
10040 STOP
10050 REM--------------
10990 REM * STATUS NOT ZERO********
11000 IF ST=64 THEN CLOSE2:PRINT"END OF DATA":FORA=1TO1500:NEXT:GOTO2015
11010 PRINT"STATUS ERROR":STOP
30000 CLOSE15,8,15:GOTO4000